home *** CD-ROM | disk | FTP | other *** search
/ Complete Linux / Complete Linux.iso / docs / apps / circuits / spice2g6.z / spice2g6 / spice / Fortran / evpoly.f < prev    next >
Encoding:
Text File  |  1989-02-03  |  1.8 KB  |  70 lines
  1.       subroutine evpoly(result,itype,lcoef,ncoef,larg,
  2.      1  narg,lexp)
  3.       implicit double precision (a-h,o-z)
  4. c
  5. c     this routine evaluates a polynomial.  lcoef points to the coef-
  6. c ficients, and larg points to the values of the polynomial argument(s).
  7. c
  8. c spice version 2g.6  sccsid=blank 3/15/83
  9.       common /blank/ value(200000)
  10.       integer nodplc(64)
  11.       complex cvalue(32)
  12.       equivalence (value(1),nodplc(1),cvalue(1))
  13. c
  14. c
  15.       if (itype) 100,200,300
  16. c
  17. c  integration (polynomial *must* be one-dimensional)
  18. c
  19.   100 result=0.0d0
  20.       arg=1.0d0
  21.       arg1=value(larg+1)
  22.       do 110 i=1,ncoef
  23.       arg=arg*arg1
  24.       result=result+value(lcoef+i)*arg/dble(i)
  25.   110 continue
  26.       go to 1000
  27. c
  28. c  evaluation of the polynomial
  29. c
  30.   200 result=value(lcoef+1)
  31.       if (ncoef.eq.1) go to 1000
  32.       call zero4(nodplc(lexp+1),narg)
  33.       do 220 i=2,ncoef
  34.       call nxtpwr(nodplc(lexp+1),narg)
  35.       if (value(lcoef+i).eq.0.0d0) go to 220
  36.       arg=1.0d0
  37.       do 210 j=1,narg
  38.       call evterm(val,value(larg+j),nodplc(lexp+j))
  39.       arg=arg*val
  40.   210 continue
  41.       result=result+value(lcoef+i)*arg
  42.   220 continue
  43.       go to 1000
  44. c
  45. c  partial derivative with respect to the itype*th variable
  46. c
  47.   300 result=0.0d0
  48.       if (ncoef.eq.1) go to 1000
  49.       call zero4(nodplc(lexp+1),narg)
  50.       do 330 i=2,ncoef
  51.       call nxtpwr(nodplc(lexp+1),narg)
  52.       if (nodplc(lexp+itype).eq.0) go to 330
  53.       if (value(lcoef+i).eq.0.0d0) go to 330
  54.       arg=1.0d0
  55.       do 320 j=1,narg
  56.       if (j.eq.itype) go to 310
  57.       call evterm(val,value(larg+j),nodplc(lexp+j))
  58.       arg=arg*val
  59.       go to 320
  60.   310 call evterm(val,value(larg+j),nodplc(lexp+j)-1)
  61.       arg=arg*dble(nodplc(lexp+j))*val
  62.   320 continue
  63.       result=result+value(lcoef+i)*arg
  64.   330 continue
  65. c
  66. c  finished
  67. c
  68.  1000 return
  69.       end
  70.